home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib01.dsk / SUPER WEAVER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  7KB  |  170 lines
  1. 2  REM  *************************
  2. 3  REM  ** SUPER WEAVER        **
  3. 4  REM  ** MICRO-SPARC         **
  4. 5  REM  ** P.O. BOX 325        **
  5. 6  REM  ** LINCOLN MASS 01773  **
  6. 7  REM  ** COPYRIGHT  C 1980   **
  7. 8  REM  *************************
  8. 9  HOME 
  9. 10  PRINT "SUPER WEAVER": PRINT "ON THE IDS 440, SET SWITCH 5 OFF AND SWITCH 3 ON": INPUT "PRESS RETURN TO CONTINUE";XX$
  10. 20 Q = 79:W = 1:D = 36:L = 1:A = 3
  11. 25  DIM T%(80),TR%(80),R%(641)
  12. 30  GOTO 100
  13. 100  REM  ** ENTER THREADING **
  14. 110  HGR : HOME 
  15. 115  HCOLOR= A: FOR PI = 0 TO 14: HPLOT 160,PI: NEXT PI
  16. 120  VTAB 24: PRINT "55= ERASE AND REENTER.  99=GO TO TIEUP";: VTAB 22: PRINT 
  17. 121  IF C = 81  THEN  VTAB 24: INVERSE : PRINT "80 THREADS REACHED.. GO TO TIE UP": FOR PI = 1 TO 1000: NEXT PI: NORMAL : GOTO 200
  18. 122  VTAB 23: CALL  -868: PRINT "THREAD #";C;: INPUT " HARNESS #? (1-8) ";N
  19. 125  IF C = 80  THEN  VTAB 21: CALL  -868: FLASH : PRINT "80 THREADS USED. AUTO-SWITCH TO TIEUP.": FOR PI = 1 TO 1000: NEXT PI: NORMAL : HOME : GOTO 200
  20. 130  IF N = 99  THEN 200
  21. 132  IF N = 55  THEN 1000
  22. 133  IF N <1  OR N >8  THEN 122
  23. 135  GOSUB 500
  24. 140  GOSUB 900
  25. 150  GOTO 122
  26. 200  REM  ** ENTER TIEUP **
  27. 202  VTAB 24: CALL  -868: PRINT "55= ERASE   77= NEXT TREADLE  99=WEAVE";: VTAB 22: PRINT 
  28. 204  IF C1 = 10  THEN  VTAB 24: PRINT "10 TREADLES REACHED.  GO TO WEAVE.": FOR PI = 1 TO 1000: NEXT PI: GOTO 600
  29. 205  VTAB 23: CALL  -868: PRINT "TREADLE #";C1;: INPUT " ENTER HARNESS #(S)";N
  30. 209  IF N = 55  THEN 300
  31. 210  IF N = 77  THEN 240
  32. 211  IF N = 99  THEN 600
  33. 218  GOSUB 500
  34. 232 T%(P *10 +C1) = 1
  35. 233 OO =  INT(200 +(C1 *3)):PP =  INT(P *2)
  36. 234  HCOLOR= 3: HPLOT OO,PP
  37. 235  GOTO 200
  38. 240 C1 = C1 +1: GOTO 200
  39. 300  REM  ERASE TIEUP ERRORS
  40. 310  GOSUB 360: GOSUB 370: REM  ERASE CURRENT TIE UP
  41. 320 C1 = C1 -1: GOSUB 360: GOSUB 370: REM  ERASE LAST TIE UP
  42. 330  GOTO 200
  43. 360  HCOLOR= 0: FOR PI = 0 TO 14  STEP 2: HPLOT 200 +(C1 *3),PI: NEXT PI: HCOLOR= 3: RETURN 
  44. 370  FOR PI = 0 TO 70  STEP 10:T%(PI +C1) = 0: NEXT PI: RETURN : REM  ERASE TABLE ENTRY
  45. 500  IF N = 8  THEN P = 0
  46. 505  IF N = 7  THEN P = 1
  47. 510  IF N = 6  THEN P = 2
  48. 515  IF N = 5  THEN P = 3
  49. 520  IF N = 4  THEN P = 4
  50. 525  IF N = 3  THEN P = 5
  51. 530  IF N = 2  THEN P = 6
  52. 540  IF N = 1  THEN P = 7
  53. 545  RETURN 
  54. 600  REM  ** WEAVING ROUTINES **
  55. 610 Y = 20: GOTO 700
  56. 650 HT = 0: REM  ** REPRINT TREADLE SEQUENCE **
  57. 651  IF TN < = 20  THEN ST = 1
  58. 652  IF TN >20  AND TN < = 40  THEN ST = 21
  59. 653  IF TN >40  AND TN < = 60  THEN ST = 41
  60. 654  IF TN >60  THEN ST = 61
  61. 655  VTAB 21
  62. 656  FOR PI = ST TO TN
  63. 660  POKE 36,HT: PRINT TR%(PI);:HT = HT +2
  64. 665  NEXT PI: VTAB 19: PRINT :HH = HT: RETURN 
  65. 700  HOME : VTAB 24: PRINT "55= ERASE LAST THROW   99= OPTIONS LIST";: VTAB 20: PRINT : IF TN >1  THEN  GOSUB 650
  66. 701 TN = TN +1: VTAB 23: CALL  -868: PRINT "ENTER TREADLE #";: INPUT TR$:TR%(TN) =  VAL(TR$): VTAB 21
  67. 702  IF TR%(TN) = 99  THEN 1100
  68. 703  IF TR%(TN) = 55  THEN  GOSUB 1900:TN = TN -2:HH = HH -2: GOTO 701
  69. 704  IF TR%(TN) <1  OR TR%(TN) >10  THEN  VTAB 23: PRINT "THE LIMIT IS 10 TREADLES.. REENTER.": FOR II = 1 TO 350: NEXT II:TN = TN -1: GOTO 701
  70. 705  IF TN > = 79  THEN TN = 79: PRINT "80 LINES ALLOWED";: INPUT "HIT RETURN TO GO TO OPTIONS LIST";XX$: GOTO 1100
  71. 706 HH = HH +2: IF FG = 1  THEN HH = HH +1:FG = 0
  72. 707  VTAB 21: HTAB HH: IF IV = 1  THEN  INVERSE 
  73. 708  PRINT TR%(TN): NORMAL : IF TR%(TN) > = 10  THEN FG = 1
  74. 709  IF HH > = 75  AND IV = 0  THEN HH = 0:IV = 1: REM  1ST WRAPAROUND AND INVERSE PRINTING
  75. 710  IF HH > = 75  AND IV = 1  THEN HH = 0:IV = 0: REM  SECOND WRAPAROUND
  76. 711  HCOLOR= 3:X = (TR%(TN) -1) +70:Z = X -70:Y = Y +2
  77. 714  FOR N = X TO Z  STEP  -10
  78. 715  IF T%(N) = 1  THEN  GOSUB 800
  79. 720  NEXT N
  80. 725  GOTO 701
  81. 800 L =  INT(N/10) *80
  82. 805  FOR J = L TO L +79
  83. 810  IF R%(J) = 1  THEN  GOTO 820
  84. 815  GOTO 850
  85. 820  HCOLOR= A: HPLOT (J -L) *2,Y
  86. 850  NEXT J
  87. 855  RETURN 
  88. 900 M = N
  89. 905 R%((P *80) +C) = L
  90. 910  HCOLOR= A: HPLOT C *2,P *2
  91. 930 C = C +1: RETURN 
  92. 1000  REM  ** ERASE THREADING ERROR **
  93. 1005 C = C -1:A = 0:L = 0:N = M
  94. 1010  HCOLOR= A: FOR PI = 0 TO 14  STEP 2: HPLOT (C *2),PI: NEXT PI
  95. 1015  FOR PI = 0 TO 560  STEP 80:R%(PI +C) = 0: NEXT PI: REM  ERASE TABLE ENTRY
  96. 1040 L = 1:A = 3: GOTO 122
  97. 1100  REM  ** OPTIONS MENU **
  98. 1102  HOME : VTAB 23: PRINT "MENU: 1=ERASE PTRN  2=ERASE PTRN/TIEUP"
  99. 1105  VTAB 24: CALL  -868: INPUT "3= PRINT PATTERN  4= RESUME WEAVING ";O
  100. 1110  IF O = 4  THEN TN = TN -1: GOTO 700
  101. 1115  IF O = 1  THEN  GOSUB 1200:TN = 0:HH = 0: GOTO 700
  102. 1120  IF O = 2  THEN TN = 0:HH = 0: GOTO 1300
  103. 1130  IF O = 3  THEN 1500
  104. 1135  IF O <1  OR O >4  THEN  PRINT "ENTER 1-4": GOTO 1100
  105. 1140  GOTO 1100
  106. 1200  REM  ** ERASE WOVEN PATTERN **
  107. 1202 A = 0: FOR U = 0 TO C *2  STEP 2
  108. 1205  FOR V = 20 TO Y  STEP 2
  109. 1210  HCOLOR= 0: HPLOT U,V
  110. 1213  VTAB 21: FLASH : PRINT "ERASING"
  111. 1220  NEXT V: NEXT U
  112. 1221  NORMAL : VTAB 21: CALL  -868
  113. 1222 A = 3:Y = 20
  114. 1225  RETURN 
  115. 1300  REM  ** ERASE TIE UP **
  116. 1302  HCOLOR= 0: FOR U = 0 TO 30  STEP 3
  117. 1305  FOR V = 0 TO 16  STEP 2
  118. 1315  HPLOT U +200,V
  119. 1320  NEXT V: NEXT U
  120. 1325  FOR PI = 0 TO 79:T%(PI) = 0: NEXT PI
  121. 1330  GOSUB 1200
  122. 1331 C1 = 0
  123. 1340  HOME : GOTO 200
  124. 1500  REM  ** PRINTING ROUTINES **
  125. 1501  HOME : VTAB 21: PRINT "ENTER COMMENTS (OR JUST HIT RETURN).": INPUT X$
  126. 1505  POKE 54,0: POKE 55,193
  127. 1507  PRINT  CHR$(30);: REM  CTL SHIFT N FOR 12 CHAR PER INCH ON IDS 440.  SET PRINTER TO 8 LINES/INCH. ENABLE LINE FEED SUPPRESSION.
  128. 1510  PRINT  CHR$(9)"95N"
  129. 1511  PRINT  CHR$(30): REM  CTL SHIFT N FOR 12 CPI
  130. 1515  PRINT X$: PRINT : REM  PRINT COMMENTS
  131. 1520  FOR Z = 0 TO 7
  132. 1525  FOR ZZ = 0 TO 79
  133. 1530  IF R%((Z *80) +ZZ) < >1  THEN 1540
  134. 1535  POKE D,ZZ: PRINT "X";
  135. 1540  NEXT ZZ
  136. 1545  FOR ZZ = 0 TO 9
  137. 1550  IF T%((Z *10) +ZZ) < >1  THEN 1560
  138. 1555  POKE 36,83 +ZZ: PRINT "X";
  139. 1560  NEXT ZZ: PRINT  CHR$(10)
  140. 1565  NEXT Z: PRINT  CHR$(10)
  141. 1570  FOR Z = 1 TO 95: PRINT "-";: NEXT Z: PRINT  CHR$(10)
  142. 1600  REM  ** PRINT PATTERN **
  143. 1602  ONERR  GOTO 2000
  144. 1605  PRINT  CHR$(9)"K";: REM  CTL I K
  145. 1610  FOR II = 1 TO TN -1
  146. 1640 X = (TR%(II) -1) +70:Z = X -70
  147. 1660  FOR N = X TO Z  STEP  -10
  148. 1662  IF N <0  THEN  PRINT  CHR$(9);"40N": PR# 0: END : REM  CTL I 40N
  149. 1665  IF T%(N) = 1  THEN  GOSUB 1800
  150. 1670  NEXT N
  151. 1675  POKE 36,82 +TR%(II): PRINT TR%(II)
  152. 1677  PRINT  CHR$(10)
  153. 1685  NEXT II
  154. 1690  PRINT  CHR$(9)"40N";: REM  CTL I 40N
  155. 1695  POKE 54,240: POKE 55,253
  156. 1697  GOTO 1100
  157. 1800  REM  ** PRINT TREADLING **
  158. 1805 L =  INT(N/10) *80
  159. 1810  FOR J = L TO L +Q
  160. 1815  IF R%(J) = W  THEN  POKE D,J -L: PRINT "X";
  161. 1820  NEXT 
  162. 1825  PRINT 
  163. 1830  PRINT  CHR$(9)"K";: REM  CTL I K
  164. 1840  RETURN 
  165. 1900  REM  ** ERASE LAST SHUTTLE THROW **
  166. 1905 A = 0:X = (TR%(TN -1) -1) +70:Z = X -70
  167. 1910  FOR N = X TO Z  STEP  -10
  168. 1920  IF T%(N) = 1  THEN  GOSUB 800
  169. 1930  NEXT N:A = 3:Y = Y -2: RETURN 
  170. 2000  PRINT  CHR$(9)"40N": PR# 0: PRINT "ERROR..RECOVER BY ENTERING 'GOTO 1100'": PRINT "AND HITTING RETURN": END